Vector.cls
Language: Visual Basic Class
Last Modified: 2020-06-27 1:58:30 PM UTC
File Size: 2873 bytes
Last Modified: 2020-06-27 1:58:30 PM UTC
File Size: 2873 bytes
http://www.penguinstew.ca/example/ExcelSQLExport/Vector.cls
VERSION10CLASS
BEGIN
MultiUse=1True
END
AttributeVB_Name=Vector
AttributeVB_GlobalNameSpace=False
AttributeVB_Creatable=False
AttributeVB_PredeclaredId=False
AttributeVB_Exposed=False
Privatem_vectorArrayAsVariant
Privatem_sizeAsInteger
Privatem_typeNameAsString
PubliccountAsInteger
PrivateSubClass_Initialize
m_size=15
Mecount=0
ReDimm_vectorArraym_size
EndSub
PublicSubSetTypeByValtypeVarAsVariant
IfNotm_typeName=Then
ErrRaisevbVariantError516VectorSetTypeVectortypealreadyset
EndIf
m_typeName=typeNametypeVar
EndSub
PublicSubAddByRefvalueAsVariant
Ifm_typeName=Then
ErrRaisevbVariantError514VectorAddVectortypeuninitialized
EndIf
IfNotm_typeName=typeNamevalueThen
ErrRaisevbVariantError515VectorAddValuetypemismatch
EndIf
IfMecount=m_sizeThen
m_size=m_size2
ReDimPreservem_vectorArraym_size
EndIf
IfIsObjectvalueThen
Setm_vectorArrayMecount=value
Else
m_vectorArrayMecount=value
EndIf
Mecount=Mecount1
EndSub
PublicSubSetAtByValindexAsIntegerByRefvalueAsVariant
Ifm_typeName=Then
ErrRaisevbVariantError514VectorAddVectortypeuninitialized
EndIf
IfNotm_typeName=typeNamevalueThen
ErrRaisevbVariantError515VectorAddValuetypemismatch
EndIf
Ifindex<MecountThen
IfIsObjectvalueThen
Setm_vectorArrayindex=value
Else
m_vectorArrayindex=value
EndIf
Else
ErrRaisevbVariantError513VectorSetAtIndexoutofrange:index
EndIf
EndSub
PublicFunctionGetAtByValindexAsIntegerAsVariant
Ifindex<MecountThen
IfIsObjectm_vectorArrayindexThen
SetGetAt=m_vectorArrayindex
Else
GetAt=m_vectorArrayindex
EndIf
Else
ErrRaisevbVariantError513VectorGetAtIndexoutofrange:index
EndIf
EndFunction
PublicSubRemoveByValindexAsInteger
Ifindex<MecountThen
Fori=indexToMecount1
IfIsObjectm_vectorArrayindexThen
Setm_vectorArrayi=m_vectorArrayi1
Else
m_vectorArrayi=m_vectorArrayi1
EndIf
Nexti
Mecount=Mecount1
Else
ErrRaisevbVariantError513VectorRemoveIndexoutofrange:index
EndIf
EndSub
PublicFunctionIsEmptyAsBoolean
IsEmpty=Mecount<=0
EndFunction
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103